home *** CD-ROM | disk | FTP | other *** search
/ Fritz: All Fritz / All Fritz.zip / All Fritz / FILES / PROGMISC / FORTRAN1.LZH / GETTERM.FOR < prev    next >
Text File  |  1988-02-08  |  2KB  |  89 lines
  1.       SUBROUTINE GETTERM ( USER, TERM )
  2. C*
  3. C*                  *******************************
  4. C*                  *******************************
  5. C*                  **                           **
  6. C*                  **          GETTERM          **
  7. C*                  **                           **
  8. C*                  *******************************
  9. C*                  *******************************
  10. C*
  11. C*     SUBPROGRAM :
  12. C*          GET TERMINAL NAME FOR USER
  13. C*
  14. C*     AUTHOR :
  15. C*          ART RAGOSTA
  16. C*          MS 207-5
  17. C*          AMES RESEARCH CENTER
  18. C*          MOFFETT FIELD, CA  94035
  19. C*          (415) 694-5578
  20. C*
  21. C*     PURPOSE :
  22. C*          CHECK TO SEE IF A USER IS LOGGED ON INTERACTIVELY, AND IF SO
  23. C*          RETURN THE TERMINAL NAME.
  24. C*
  25. C*     INPUT ARGUMENTS :
  26. C*          USER  - THE NAME OF THE USER
  27. C*
  28. C*     OUTPUT ARGUMENTS :
  29. C*          TERM  - THE TERMINAL NAME (EG, 'TTA0' )
  30. C*
  31. C*     INTERNAL WORK AREAS :
  32. C*          NONE
  33. C*
  34. C*     COMMON BLOCKS :
  35. C*          NONE
  36. C*
  37. C*     FILE REFERENCES :
  38. C*          NONE
  39. C*
  40. C*     SUBPROGRAM REFERENCES :
  41. C*          JPI$_TERMINAL
  42. C*          SYS$GETJPIW
  43. C*
  44. C*     ERROR PROCESSING :
  45. C*          NONE
  46. C*
  47. C*     TRANSPORTABILITY LIMITATIONS :
  48. C*          ABSOLUTELY NOT TRANSPORTABLE
  49. C*
  50. C*     ASSUMPTIONS AND RESTRICTIONS :
  51. C*          NONE
  52. C*
  53. C*     LANGUAGE AND COMPILER :
  54. C*          ANSI FORTRAN 77
  55. C*
  56. C*     VERSION AND DATE :
  57. C*          VERSION I.0     12-APR-85
  58. C*
  59. C*     CHANGE HISTORY :
  60. C*          12-APR-85    INITIAL VERSION
  61. C*
  62. C***********************************************************************
  63. C*
  64.       CHARACTER *(*) USER, TERM
  65.       CHARACTER *8 TT
  66.       INTEGER *2 ITEM(2)
  67.       INTEGER *4 ITMLST(3), IOSB(2)
  68.       EQUIVALENCE (ITEM(1),ITMLST(1))
  69.       EXTERNAL JPI$_TERMINAL, SS$_NORMAL
  70. C
  71.       TERM = ' '
  72. C
  73. C --- USE GETJPI TO GET TERMINAL NAME
  74. C
  75.       ITEM(1)   = 8
  76.       ITEM(2)   = %LOC(JPI$_TERMINAL)
  77.       ITMLST(2) = %LOC( TT )
  78.       ITMLST(3) = %LOC( LENG )
  79.       LU        = LENGTH(USER)
  80.       ISTAT     = SYS$GETJPIW ( ,, USER(1:LU), ITMLST, IOSB,, )
  81.       IF ( IOSB(1) .NE. %LOC(SS$_NORMAL) ) GO TO 1000
  82.       TERM      = TT
  83. C
  84. 1000  RETURN
  85.       END
  86. C
  87. C---END GETTERM
  88. C
  89.